home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / tjgold.zip / INSTALL.003 / REGISTER.PAS < prev    next >
Pascal/Delphi Source File  |  1995-05-29  |  17KB  |  479 lines
  1. {--------------------------------------------------------------------------}
  2. {                Product: TechnoJock's Turbo Toolkit GOLD                  }
  3. {                                                                          }
  4. {                     TTT GOLD - REIGISTER PROGRAM                        }
  5. {                                                                          }
  6. {                Copyright 1986-1995  TechnoJock Software, Inc.            }
  7. {                           All Rights Reserved                            }
  8. {                          Restricted by License                           }
  9. {--------------------------------------------------------------------------}
  10.  
  11. {Description: REGISTER.PAS
  12.               Helps the user create a Registration form.
  13. }
  14.  
  15. Program REGISTER;
  16.  
  17. {$I GOLDFLAG.INC}
  18.  
  19. uses CRT, GoldAttr, GoldMisc, GoldFast, GoldList, Goldkey, GoldDir, GoldDate,
  20.           GoldStr, GoldWin, GoldLink, GoldIO, GoldIO2, GoldIO3, GoldRead;
  21.  
  22. var
  23.   Response: integer;
  24.   {IO form vars}
  25.   Name,
  26.   Address,
  27.   City,
  28.   State,
  29.   Zip,
  30.   Country,
  31.   Tel,
  32.   Fax,
  33.   EMail: string[80];
  34.   Copies: longint;
  35.   PostalZone: integer;
  36.   PrevPayment: integer;
  37.   Creditcash: byte;
  38.   Visa: byte;
  39.   CardName,
  40.   CardAddress,
  41.   CardNum,
  42.   CardExpire: string;
  43.  
  44.   CostUnit,
  45.   CostTaxes,
  46.   CostShip,
  47.   CostTotal: real;
  48.  
  49. const
  50.    CashTax = 0.08;
  51.    CreditTax = 0.0825;
  52.    BasePrice = 89.95;
  53.    ShipUS = 6.00;
  54.    ShipCanada = 10.00;
  55.    ShipMexico = 15.00;
  56.    ShipEurope = 25.00;
  57.    ShipOther = 30.00;
  58.    ValError = ' Validation Error ';
  59.  
  60. {$F+}
  61. procedure CheckPayment(CurrentField:byte;var Refresh:byte);
  62. {Manages field enabling based on value of payment method}
  63. var
  64.   FieldState: gActiveState;
  65.  
  66.    procedure GrayFields;
  67.    var I: integer;
  68.    begin
  69.       if (PrevPayment = CreditCash) then
  70.          exit;
  71.       if CreditCash > 1 then
  72.          FieldState := FldOff
  73.       else
  74.          FieldState := FldOn;
  75.       for I := 11 to 15 do
  76.         FieldSetState(I,FieldState);
  77.       PrevPayment := CreditCash;
  78.       Refresh := RefreshAll;
  79.    end;
  80.  
  81.    function Value(Input:Real):string;
  82.    begin
  83.       Value := padright('$'+RealtoStr(Input,2),8,' ');
  84.    end;
  85.  
  86.    procedure UpdateCost;
  87.    const RM=68;
  88.    begin
  89.       CostUnit := BasePrice*Copies;
  90.       case PostalZone of
  91.         1: CostShip := 0.00;
  92.         2,3: CostShip := ShipUS*Copies;
  93.         4: CostShip := ShipCanada*Copies;
  94.         5: CostShip := ShipMexico*Copies;
  95.         6: CostShip := ShipEurope*Copies;
  96.         else
  97.            CostShip := ShipOther*Copies;
  98.       end;
  99.       if PostalZone <> 2 then
  100.          CostTaxes := 0
  101.       else
  102.       begin
  103.          if CreditCash = 1 then
  104.             CostTaxes := (CostShip + CostUnit) * CreditTax
  105.          else
  106.             CostTaxes := (CostShip + CostUnit) * CashTax
  107.       end;
  108.       CostTotal := CostUnit + CostShip + CostTaxes;
  109.       WriteRight(RM,20,blueonlightgray,Value(CostUnit));
  110.       if CostShip = 0 then
  111.       begin
  112.          WriteRight(RM,21,blueonlightgray,'Unknown');
  113.          WriteRight(RM,22,blueonlightgray,'Unknown');
  114.          WriteRight(RM,23,blueonlightgray,'Unknown');
  115.       end
  116.       else
  117.       begin
  118.          WriteRight(RM,21,blueonlightgray,Value(CostShip));
  119.          WriteRight(RM,22,blueonlightgray,Value(CostTaxes));
  120.          WriteRight(RM,23,blueonlightgray,Value(CostTotal));
  121.       end;
  122.    end;
  123.  
  124. begin
  125.    case CurrentField of
  126.      0,10: begin
  127.         GrayFields;
  128.         UpdateCost;
  129.      end;
  130.      16,17: UpdateCost;
  131.    end;
  132. end; {CheckFormats}
  133. {$F-}
  134.  
  135. {$F+}
  136. function MyFinishHook:byte;
  137. {}
  138. begin
  139.    MyFinishHook := 0; {assume all is well}
  140.    {check to see that the postal zone is assigned}
  141.    if PostalZone = 1 then
  142.    begin
  143.       PromptOk(ValError,'You must select a postal zone before printing');
  144.       MyFinishHook := 16;
  145.    end
  146.    else if CreditCash = 1 then
  147.    begin
  148.       if length(CardNum) < 10 then
  149.       begin
  150.         PromptOk(ValError,'Enter a valid card number');
  151.         MyFinishHook := 14;
  152.       end
  153.       else if length(CardExpire) < 4 then
  154.       begin
  155.         PromptOk(ValError,'Enter your cards expiration date in the MM/YY format.');
  156.         MyFinishHook := 15;
  157.       end;
  158.    end;
  159. end;
  160. {$F-}
  161.  
  162. procedure InitVars;
  163. const
  164.    LM = 21; {left margin}
  165.    XM = 5;  {extra indent}
  166. begin
  167.    Name := '';
  168.    Address := '';
  169.    City := '';
  170.    State := '';
  171.    Zip := '';
  172.    Country := '';
  173.    Tel := '';
  174.    Fax := '';
  175.    Email := '';
  176.    Copies := 1;
  177.    Visa := 1;
  178.    PrevPayment := -1; {ensures fields are enabled first time through}
  179.    Creditcash := 1;
  180.    PostalZone := 1;
  181.    CardName := 'As Above';
  182.    CardAddress := 'As Above';
  183.    CardNum := '';
  184.    CardExpire := '';
  185.    CreateForms(1);
  186.    {Set up the Hind hook for checking field entries on the fly}
  187.    AssignHindHook(CheckPayment);
  188.    AssignFinishedHook(MyFinishHook);
  189.    SetValidation(ValidateAtEnd);
  190.    KwikAddField(1,LM,3);
  191.    KwikAddField(2,LM,4);
  192.    KwikAddField(3,LM,5);
  193.    KwikAddField(4,LM,6);
  194.    KwikAddField(5,58,6);
  195.    KwikAddField(6,LM,7); {country}
  196.    KwikAddField(7,10,8); {tel}
  197.    KwikAddField(8,33,8); {fax }
  198.    KwikAddField(9,58,8); {email}
  199.    KwikAddField(10,LM,10); {cash or credit}
  200.    KwikAddField(11,LM+33,10); {credit type}
  201.    KwikAddField(12,LM+XM,15); {credit name}
  202.    KwikAddField(13,LM+XM,16); {credit address}
  203.    KwikAddField(14,LM+XM,17); {credit number}
  204.    KwikAddField(15,LM+50,17); {expires}
  205.    KwikAddField(16,LM+XM,19); {postal zone}
  206.    KwikAddField(17,LM+19,20); {how many}
  207.    { buttons }
  208.    KwikAddField(18, 10, 22);
  209.    KwikAddLastField(19, 30,22);
  210.    { Name }
  211.    StringField(1,Name,Replicate(55,'*'));
  212.    SetLabel(1,LabelLeft,LabelLeft,'~N~ame');
  213.    SetHK(1,305);
  214.    SetMessage(1,0,0,'Enter your first and last name');
  215.    FieldRules(1,NoRules+EraseDefault,[NoChar],[NoChar]);
  216.    { Address }
  217.    StringField(2,Address,Replicate(55,'*'));
  218.    SetLabel(2,LabelLeft,LabelLeft,'~A~ddress');
  219.    SetHK(2,286);
  220.    SetMessage(2,0,0,'Enter your street + apartment address');
  221.    FieldRules(2,NoRules+EraseDefault,[NoChar],[NoChar]);
  222.    { City }
  223.    StringField(3,City,Replicate(30,'*'));
  224.    SetLabel(3,LabelLeft,LabelLeft,'~C~ity');
  225.    SetHK(3,302);
  226.    SetMessage(3,0,0,'Enter your city');
  227.    FieldRules(3,NoRules+EraseDefault,[NoChar],[NoChar]);
  228.    { State }
  229.    StringField(4,State,Replicate(22,'*'));
  230.    SetLabel(4,LabelLeft,LabelLeft,'~S~tate/Province');
  231.    SetHK(4,287);
  232.    SetMessage(4,0,0,'Enter your State or Province');
  233.    { Zip }
  234.    StringField(5,Zip,Replicate(18,'*'));
  235.    SetLabel(5,LabelLeft,LabelLeft,'~Z~ip/Postcode');
  236.    SetHK(5,300);
  237.    SetMessage(5,0,0,'Enter your Zip or Postal code');
  238.    { Country }
  239.    StringField(6,Country,Replicate(30,'*'));
  240.    SetLabel(6,LabelLeft,LabelLeft,'~C~ountry');
  241.    SetHK(6,302);
  242.    SetMessage(6,0,0,'Enter your country (blank for USA)');
  243.    { Telephone }
  244.    StringField(7,Tel,Replicate(18,'*'));
  245.    SetLabel(7,LabelLeft,LabelLeft,'~T~el');
  246.    SetHK(7,276);
  247.    SetMessage(7,0,0,'Enter your daytime telephone number');
  248.    { Fax }
  249.    StringField(8,Fax,Replicate(18,'*'));
  250.    SetLabel(8,LabelLeft,LabelLeft,'~F~ax');
  251.    SetHK(8,289);
  252.    SetMessage(8,0,0,'Enter your FAX telephone number');
  253.    { Email }
  254.    StringField(9,Email,Replicate(18,'*'));
  255.    SetLabel(9,LabelLeft,LabelLeft,'~E~mail');
  256.    SetHK(9,289);
  257.    SetMessage(9,0,0,'Enter your Email address');
  258.    { Payment method }
  259.    RadioField(10,20,4,CreditCash);
  260.    RadioAddItem(10,1,1,'Credit Card','Paying by credit card',302);
  261.    RadioAddItem(10,1,2,'Cash','Sending US dollar bills',294);
  262.    RadioAddItem(10,1,3,'Check','Sending a US dollar check with an ABA routing number',294);
  263.    RadioAddItem(10,1,4,'Money Order','Sending US dollar money order',294);
  264.    SetLabel(10,LabelLeft,LabelLeft,'Payment method');
  265.    {Card Type}
  266.    RadioField(11,22,4,Visa);
  267.    RadioAddItem(11,1,1,'Visa','Paying with Visa card',0);
  268.    RadioAddItem(11,1,2,'Mastercard','Paying with Mastercard',0);
  269.    RadioAddItem(11,1,3,'Discover','Paying with Discover card',0);
  270.    RadioAddItem(11,1,4,'American Express','Paying with American Express card',0);
  271.    SetLabel(11,LabelLeft,LabelLeft,'Card Type');
  272.    { Credit Name }
  273.    StringField(12,CardName,Replicate(30,'!'));
  274.    SetLabel(12,LabelLeft,LabelLeft,'Card Holder''s Name');
  275.    SetMessage(12,0,0,'Enter the name exactly as it appears on the card');
  276.    { Credit Address }
  277.    ScrollField(13,CardAddress,30,80);
  278.    SetLabel(13,LabelLeft,LabelLeft,'Holder''s Address');
  279.    SetMessage(13,0,0,'Enter the card holder''s address');
  280.    {card number}
  281.    StringField(14,CardNum,Replicate(30,'#'));
  282.    SetLabel(14,LabelLeft,LabelLeft,'Card Number');
  283.    SetMessage(14,0,0,'Enter your credit card number');
  284.    {card expires}
  285.    StringField(15,CardExpire,'##/##');
  286.    SetLabel(15,LabelLeft,LabelLeft,'Card Expires');
  287.    SetMessage(15,0,0,'When does the card expire? Format MM/YY');
  288.    {Postal Zone}
  289.    SpinDropListField(16,16,PostalZone);
  290.    ListKwikAddItem(16,'(Not assigned)|Texas|USA|Canada|Mexico|Europe|Australasia|Other');
  291.    SetLabel(16,LabelLeft,LabelLeft,'Postal Zone');
  292.    SetMessage(16,0,0,'Select general postal zone (for computing S&H and taxes)');
  293.  
  294.    {Num copies}
  295.    SpinLongField(17,Copies,2,1,95,1);
  296.    SetLabel(17,LabelLeft,LabelLeft,'Number of copies              ');
  297.    SetMessage(17,0,0,'How many copies of Gold do you want to order?');
  298.    { Buttons }
  299.    ButtonField(18,' Print Order ',Finished);
  300.    SetMessage(18,0,0,'Print the order form');
  301.    ButtonDefaultField(19,'  Close Form  ',Escaped);
  302.    SetMessage(19,0,0,'Quit without printing the order form');
  303. end;
  304.  
  305. procedure SetBackground;
  306. begin
  307.    Clear(whiteonblue,chr(177));
  308.    ClearLine(1,lightgrayonblue);
  309.    ClearLine(25,lightgrayonblue);
  310.    WriteCenter(1,0,'Gold Registration');
  311.    WriteCenter(25,0,'Copyright 1986-1995 TechnoJock Software, Inc.');
  312. end;
  313.  
  314. procedure Benefits;
  315. var
  316.    StrLL: StringLL;
  317.    Ecode: integer;
  318. begin
  319.    Clear(whiteonblue,chr(177));
  320.    StrLLInit(StrLL);
  321.    ECode := 0;
  322.    inc(ECode, StrLLAdd(StrLL,'Gold is distributed as a ~Shareware~ product. When you register '));
  323.    inc(ECode, StrLLAdd(StrLL,'your copy of the program, you not only get the latest version'));
  324.    inc(ECode, StrLLAdd(StrLL,'of the toolkit, you also receive the following bonus features:'));
  325.    inc(ECode, StrLLAdd(StrLL,''));
  326.    inc(ECode, StrLLAdd(StrLL,'~Books~       You get two professionally bound and typeset manuals!'));
  327.    inc(ECode, StrLLAdd(StrLL,''));
  328.    inc(ECode, StrLLAdd(StrLL,'~Desktop~     The desktop unit allows you to easily create desktop'));
  329.    inc(ECode, StrLLAdd(StrLL,'            applications with pulldown menus, status bar, etc.'));
  330.    inc(ECode, StrLLAdd(StrLL,'            Run DEMOVIEW.EXE to see a slick desktop in action.'));
  331.    inc(ECode, StrLLAdd(StrLL,''));
  332.    inc(ECode, StrLLAdd(StrLL,'~Calculator~  Add a fully functional calculator to your apps with a'));
  333.    inc(ECode, StrLLAdd(StrLL,'            couple of lines of code.'));
  334.    inc(ECode, StrLLAdd(StrLL,''));
  335.    inc(ECode, StrLLAdd(StrLL,'~INI Unit~    This unit makes it a snap to add Windows-style INI'));
  336.    inc(ECode, StrLLAdd(StrLL,'            file support to your programs.'));
  337.    inc(ECode, StrLLAdd(StrLL,''));
  338.    inc(ECode, StrLLAdd(StrLL,'~Online Help~ The entire function reference as a BP7 help file.'));
  339.    if ECode = 0 then
  340.      PromptOKStrLL(' Benefits of Registration ',StrLL)
  341.    else
  342.      PromptOK(' OOPS ', 'There is insufficient memory to display the benefits');
  343.    StrLLDestroy(StrLL);  {dispose of linked list}
  344. end;
  345.  
  346. procedure OrderIt;
  347. var
  348.   PChoice: byte;
  349.  
  350.    procedure SetScreen;
  351.    begin
  352.       Clear(whiteonlightgray,' ');
  353.       Box3D(1,1,80,24,blackonlightgray,whiteonlightgray,1);
  354.       HorizLine(3,78,9,blackonlightgray,1);
  355.       HorizLine(3,78,18,blackonlightgray,1);
  356.       WriteCenter(1,whiteonred,' GOLD Order Form ' );
  357.       ClearLine(25,lightgrayonblue);
  358.       WriteAT(64,19,MagentaonLightgray,'Cost');
  359.       WriteAT(55,20,MagentaonLightgray,'Gold');
  360.       WriteAT(55,21,MagentaonLightgray,'S & H');
  361.       WriteAT(55,22,MagentaonLightgray,'Taxes');
  362.       WriteAT(55,23,MagentaonLightgray,'TOTAL');
  363.    end;
  364.  
  365.    procedure PrintTheForm;
  366.    const
  367.       LM = 15;      {left margin}
  368.       CM=  40;      {cash margin}
  369.    var
  370.      ThePort: Text;
  371.    begin
  372.      assign(ThePort,'LPT'+IntToStr(PChoice));
  373.      rewrite(ThePort);
  374.      writeln(ThePort,'GOLD Order Form        Printed: '+FancyDateStr(TodayInJul,false,false));
  375.      writeln(ThePort);
  376.      writeln(ThePort,Padleft('Name:',LM,' ')+Name);
  377.      writeln(ThePort,Padleft('Address:',LM,' ')+Address);
  378.      writeln(ThePort,Padleft('City/St/Zip:',LM,' ')+City+', '+State+', '+Zip);
  379.      writeln(ThePort,Padleft('Country:',LM,' ')+Country);
  380.      writeln(ThePort,'Tel: '+tel+' Fax: '+Fax+' Email: '+Email);
  381.      writeln(ThePort);
  382.      writeln(ThePort,Padleft('Copies:',LM,' ')+IntToStr(Copies));
  383.      writeln(ThePort,Padleft('Extended price:',CM,' ')+PadRight('$'+RealToStr(CostUnit,2),8,' '));
  384.      writeln(ThePort,Padleft('Taxes:',CM,' ')+PadRight('$'+RealToStr(CostTaxes,2),8,' '));
  385.      writeln(ThePort,Padleft('Shipping & Handling:',CM,' ')+PadRight('$'+RealToStr(CostShip,2),8,' '));
  386.      writeln(ThePort,Padleft('Total Cost:',CM,' ')+PadRight('$'+RealToStr(CostTotal,2),8,' '));
  387.      writeln(ThePort);
  388.      if Creditcash = 1 then {credit card order}
  389.      begin
  390.         writeln(ThePort);
  391.         writeln(ThePort,'** CREDIT CARD ORDER **');
  392.         writeln(ThePort);
  393.         writeln(ThePort,Padleft('Card Holder:',LM,' ')+CardName);
  394.         writeln(ThePort,Padleft('Card Address:',LM,' ')+CardAddress);
  395.         write(ThePort,Padleft('Card Type:',LM,' '));
  396.         case Visa of
  397.           1: writeln(ThePort,'VISA');
  398.           2: writeln(ThePort,'MASTERCARD');
  399.           3: writeln(ThePort,'DISCOVER');
  400.           4: writeln(ThePort,'AMERICAN EXPRESS');
  401.         end;
  402.         writeln(ThePort,Padleft('Card Number:',LM,' ')+CardNum);
  403.         insert('/',CardExpire,3);
  404.         writeln(ThePort,Padleft('Expires:',LM,' ')+CardExpire);
  405.         writeln(ThePort);
  406.         writeln(ThePort,'Mail or FAX to:');
  407.         writeln(ThePort,Padleft('',LM,' ')+'Public Software Library');
  408.         writeln(ThePort,Padleft('',LM,' ')+'PO Box 35705');
  409.         writeln(ThePort,Padleft('',LM,' ')+'Houston TX 77235-5705');
  410.         writeln(ThePort,Padleft('',LM,' ')+'USA');
  411.         writeln(ThePort,Padleft('',LM,' ')+'FAX: (713) 524 6398');
  412.     end
  413.      else
  414.      begin
  415.         writeln(ThePort);
  416.         writeln(ThePort,'** CASH/CHECK/MONEY ORDER **');
  417.         writeln(ThePort);
  418.         writeln(ThePort,'Mail to:');
  419.         writeln(ThePort,Padleft('',LM,' ')+'TJ Software, Inc.');
  420.         writeln(ThePort,Padleft('',LM,' ')+'6212 Sea Isle, Suite 300');
  421.         writeln(ThePort,Padleft('',LM,' ')+'Galveston TX 77554');
  422.         writeln(ThePort,Padleft('',LM,' ')+'USA');
  423.         writeln(ThePort,Padleft('',LM,' ')+'FAX: (713) 524 6398');
  424.      end;
  425.      writeln(ThePort);
  426.      writeln(ThePort,'In the software business since Tuesday!');
  427.    end;
  428.  
  429. begin
  430.    SetScreen;
  431.    DisplayForm;
  432.    if EditForm(1) = Finished then
  433.    begin
  434.       repeat
  435.         PChoice := PromptRadio(0,0,'Which printer port?',
  436.           'Select a printer', 'LPT1|LPT2|LPT3',1);
  437.         if ReadVars.LastAction <> Escaped then
  438.         begin
  439.           MiscVars.LptPort := pred(PChoice);
  440.           if not PrinterReady then
  441.             PromptOK(' Printer Error ', 'Check the printer is online and ready, or choose another port')
  442.           else  {lets print the sucker}
  443.           begin
  444.              PrintTheForm;
  445.              PChoice := 0;
  446.              PromptOK(' Thank-you ', 'We appreciate your support!');
  447.           end;
  448.         end;
  449.       until (PChoice = 0) or (ReadVars.LastAction = Escaped);
  450.    end;
  451. end;
  452.  
  453. begin
  454. {$IFOPT D+}
  455.   HeapRecord;
  456. {$ENDIF}
  457.   MouseShow(true);
  458.   InitVars;
  459.   Response := 1;
  460.   repeat
  461.     SetBackground;
  462.     Response := PromptCustom(' Gold Registration ','|This application explains the '+
  463.       'benefits of registering|Gold, and provides a fill-in-the-blanks '+
  464.       'form to help|you print an order form. Alternatively, you can edit|'+
  465.       'and print the text file ORDERFRM.DOC.|',' ~B~enefits ','  ~O~rder  ','   ~Q~uit   ',
  466.       304,280,272,Response,0);
  467.     if Response = 1 then
  468.       Benefits
  469.     else if Response = 2 then
  470.       OrderIt;
  471.   until Response = 3;
  472.   MouseShow(false);
  473.   DisposeFields;
  474.   DisposeForms;
  475.   ResetStartupMode;
  476. {$IFOPT D+}
  477.   HeapCheck;
  478. {$ENDIF}
  479. end.